home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
basic
/
qinp73.zip
/
QINP73.BAS
< prev
next >
Wrap
BASIC Source File
|
1990-06-03
|
56KB
|
1,840 lines
' Microsoft BASIC 7.0, Professional Development System
' Copyright (C) 1987-1989, Microsoft Corporation
'
' Microsoft QBX 7.0, Professional Development System
' Copyright (C) 1987-1989, Microsoft Corporation
'
' Raymond E Dixon
' 5815 Buckley Dr.
' Jacksonville, Fl. 32244
'
' (904) 778-4048
' (904) 772-0329
'
' I think the only routine that won't work with QB45 is "SLEEP()"(removed)
' which is a QBX function , replace a loop for QB45.
' I started all subs with Q so not to conflict with other subs
' when I need to load and move to my programs.
' ALL the main code is for testing the sub.
'
' UPDATES: and a few comments from aurthor.
'
' started 05/12/90
' added numeric input 5/30/90 to handle decimal, neg and real numbers
' in numericinput only numbers and decimal allowed in format
' speeded up input routine by removing unessary code.
' removed SLEEP()
' fixed a few bugs 06/03/90
' after many hours work seems to function the way I had hope for.
'*************** Declarations and definitions begin here ********************
DEFINT A-Z 'Resets the default data type from single precision to integer
DECLARE FUNCTION Qformateditnum$ (work$, format$, ExitCode%, UPflag%, PGUPflag%, DNflag%, PGDNflag%, RETflag%, TABflag%, ESCflag%)
DECLARE FUNCTION Qformateditstr$ (work$, format$, caseflag%, ExitCode%, UPflag%, PGUPflag%, DNflag%, PGDNflag%, RETflag%, TABflag%, ESCflag%)
DECLARE FUNCTION Qremovechar$ (userstring$, skip$)
DECLARE FUNCTION Qremoveformat$ (instring$, format$)
DECLARE FUNCTION Quserformat$ (inputstring$, format$)
DECLARE SUB Qdrawscreen ()
DECLARE SUB Qmessage (msg$, row%)
DECLARE SUB Qsglbox (scol1%, srow1%, ecol1%, erow1%)
DECLARE SUB Qdblbox (leftcol%, leftrow%, rightcol%, rightrow%)
DECLARE SUB QformatDEC (a$, beforeDEC%, afterdec%)
DECLARE SUB Qclreol ()
DECLARE SUB Qclrscrn (startline%, endline%, startcol%, endcol%)
' Define names similar to keyboard names with their equivalent key codes.
CONST SPACE = 32, ESC = 27, enter = 13, TABKEY = 9
CONST DOWN = 80, UP = 72, LEFT = 75, RIGHT = 77
CONST HOME = 71, ENDK = 79, PGDN = 81, PGUP = 73
CONST INS = 82, DEL = 83, NULL = 0
CONST CTRLD = 4, CTRLG = 7, CTRLH = 8, CTRLS = 19, CTRLV = 22
' Define English names for color-specification numbers. Add BRIGHT to
' any color to get bright version.
CONST BLACK = 0, blue = 1, GREEN = 2, CYAN = 3, RED = 4, MAGENTA = 5
CONST YELLOW = 6, WHITE = 7, BRIGHT = 8
' Assign colors to different kinds of text. By changing the color assigned,
' you can change the color of the display. The initial colors are
' chosen because they work for color or black-and-white displays.
' Codes for normal and highlight
HILITE = WHITE + BRIGHT
CONST BACKGROUND = blue
CONST normal = WHITE + BRIGHT
' Miscellaneous symbolic constants
CONST False = 0, True = 1
CONST CURSORON = 1, CURSOROFF = 0
'set edit colors
'Editbackground = RED
'Editforeground = WHITE + BRIGHT
'set edit to reverse
editbackground = normal
editforeground = blue
'*************** Declarations and definitions end here ********************
COLOR HILITE, blue
CLS
Qdrawscreen
Qclrscrn 4, 20, 2, 78
msg$ = "ESC restores CTRL-E Clears, all other edit keys function normal"
Qmessage msg$, 3
start:
'
' comment out the format$ that are not being used and a instring to match
' except for prompt message.
' format$ can not be a null
' string passed maybe null "" or any basic string
' there are so many formats that I only listed a few, just try yours
'GOTO num
'******************************************************************
instring$ = "887649889"
msg1$ = ": string returned unformated"
format$ = "(999)-(99)-(9999) SS number"
msg2$ = ": enter data at specified position"
GOSUB teststring
'******************************************************************
instring$ = "409"
msg1$ = ": enter at specified area using string input"
format$ = "before:>999<:after"
msg2$ = ": before and after prompts"
GOSUB teststring
'*******************************************************************
instring$ = "123456789"
msg1$ = ": numeric input are right justified"
format$ = "9999999"
msg2$ = ": if longer than format left characters are lost"
GOSUB testnumeric
'*******************************************************************
instring$ = "123.4500"
msg1$ = ": decimal numbers are aligned"
format$ = "99999.99"
msg2$ = ": for numeric input all numbers are input right to left"
GOSUB testnumeric
'*******************************************************************
instring$ = "44.00"
msg1$ = ": instring$ maybe upto 80 char"
format$ = "99999.999"
msg2$ = ": format maybe different decimal pos"
GOSUB testnumeric
'***********************************************
instring$ = "7770329"
msg1$ = ": seven digit phone numbers"
format$ = " 999-9999 seven digit phone" ' 7 digit phone
msg2$ = ": allmost any format using string input"
GOSUB teststring
'***********************************************
instring$ = "9047784048" ' 10 digit phone
msg1$ = ": ten digit phone numbers"
format$ = "(999) 999-9999"
msg2$ = ": allmost any format"
GOSUB teststring
msg1$ = ": ten digit phone numbers"
' with user prompt
format$ = "Area Code: (999) Phone: 999-9999"
msg2$ = ": allmost any format, even user prompt "
GOSUB teststring
'********************************************************
instring$ = Qremovechar(LEFT$(DATE$, 6), "-") + RIGHT$(DATE$, 2)
' instring="040146" ' date input
msg1$ = ": date formated input"
format$ = " 19/39/99 " 'mask for month/day/year
msg2$ = ": with limited entry"
GOSUB teststring
'***********************************************
instring$ = "M"
msg1$ = ": maybe preset to Male or Female"
format$ = "Enter Male or Female ? (M/F):|" ' one char M/F
msg2$ = ": only MF allowed"
GOSUB teststring
'********************************************************
instring$ = "A124444"
msg1$ = ": account numbers"
format$ = "ACC NO: @99-9999" 'first char is alpha only ,rest numeric
msg2$ = ": any format with alpha only first digit"
GOSUB teststring
'********************************************************
' for fixed length strings or user type
instring$ = "raymond e dixon"
msg1$ = ": may force caps, upper, lower or any case "
'format$ = STRING$(LEN(instring$), "@")
msg2$ = ": alpha input only, alphanumeric or numeric only"
format$ = ">@@@@@@@@@@@@@@@@@@@@@@@<"
GOSUB teststring
'********************************************************
instring$ = ""
msg1$ = ": force enterkey or exitkey only, for msg display "
format$ = " Press ENTER key to Continue ~" '(~) requires enter to be pressed
msg2$ = ": any single line message can be displayed"
GOSUB teststring
'********************************************************
msg1$ = ""
redosformat:
msg2$ = " Enter Your Format String (no quotes): "
format$ = msg2$ + STRING$(25, "#")
Qclrscrn 4, 20, 2, 78
LOCATE 4, 4
PRINT "Formats Allowed:";
LOCATE 5, 5
PRINT CHR$(34) + "99" + CHR$(34) + " ' numbers only < (99 max) each digit = to max value";
LOCATE 6, 5
PRINT CHR$(34) + "19" + CHR$(34) + " ' (19) is max value";
LOCATE 7, 5
PRINT CHR$(34) + "999-99-9999 SS number" + CHR$(34);
LOCATE 8, 5
PRINT CHR$(34) + "999-9999; " + CHR$(34) + " ' 7 digit phone";
LOCATE 9, 5
PRINT CHR$(34) + "(999) 999-9999" + CHR$(34) + " ' 10 digit phone";
LOCATE 10, 5
PRINT CHR$(34) + "19/39/99" + CHR$(34) + " ' date format";
LOCATE 11, 5
PRINT CHR$(34) + "########" + CHR$(34) + " '# alphanumeric set for 8 characters maybe more or less";
LOCATE 12, 5
PRINT CHR$(34) + "@@@@